perm filename MSSNGR.SAI[PNT,HE]1 blob sn#417612 filedate 1979-02-08 generic text, type C, neo UTF8
COMMENT ⊗   VALID 00005 PAGES
C REC  PAGE   DESCRIPTION
C00001 00001
C00002 00002	ENTRY
C00004 00003	!  PEEK, POKE, PEEKARRAY, POKEARRAY
C00012 00004	!	eval 
C00017 00005	!	alinit
C00018 ENDMK
C⊗;
ENTRY;
BEGIN
DEFINE $MSSNGR=TRUE;
REQUIRE "HEADER.SAI" SOURCE_FILE;
DEFINE	WAKEUP = '0,
	ASLEEP = '0,
	AWAKE  = '100,
	LISTEN =  '1,
	LISTENING = '101,
	WORK   =  '2,
	WORKING = '102,
	DONEWORKING= '103,
	GAVEUP = '104,
	GOSLEEP = '3;

DEFINE MAP_OFFSET = "'320000";  ! Converts virtual addresses to physical ones;
DEFINE NOTB10 = "'160000";  ! The notebox from 11 to the 10 (byte address);
DEFINE NOTB11 = "'160020";  ! The notebox from 10 to the 11 (byte address);

! DEFINE OUTTST = "OUTSTR";
  DEFINE OUTTST = "! ";


INTEGER ARRAY NOTBOX[1:8];
DEFINE PCDBUF="NOTBOX[2]",
  	INTBUF="NOTBOX[3]",
	FPBUF="NOTBOX[4]",
	INTPTR="NOTBOX[5]",
	FPPTR="NOTBOX[6]",
	INTSIZ="NOTBOX[7]",
	FPSIZ="NOTBOX[8]";

INTEGER ELFCHAN;  !  Channel number for I/O to ELF;

PROCEDURE COMERR
      (STRING MESSG;RECORD_POINTER(ANY_CLASS) CONTXT (NULL_RECORD));
        !  Non-fatal warnings;
        BEGIN
        USERERR(0,1,"HAH!  "&MESSG);
        END;

INTEGER ARRAY TMPBUF[1:1000];
!  PEEK, POKE, PEEKARRAY, POKEARRAY;


DEFINE MTAPE = "'072000";

INTEGER PROCEDURE PEEK(INTEGER ADR);
    BEGIN "peek"  !  Returns the ELF word at unibus address ADR;
    DEFINE PEEK = "'002000000000";
    LABEL PEK1, PEKMTA, PEK3, PEK4, PEK5;
    INTEGER ANS, ADR1;
    ADR1 ← ADR;

    START_CODE;
	MOVE	1,ADR1   	; !  Prepare MTAPE data in PEK1;
	LSH	1,-1    	;
	HRRM	1,PEK1   	;
	MOVE	1,ELFCHAN	; !  Prepare MTAPE in PEKMTA;
	LSH	1,5	    	;
	ADDI	1,MTAPE 	;
	HRLM	1,PEKMTA   	;
    PEKMTA:
	PEK1             	; !  This will become MTAPE ELFCHAN,PEK1;
	JRST PEK3        	; !  Error;
	JRST PEK4        	; !  OK;
    PEK1:
	PEEK    		;
    PEK5:
	0       		;
    PEK3:
	SETOM   PEK5     	; ! Error result;
    PEK4:
	MOVE    1,PEK5   	;
	MOVEM	1,ANS	   	;
    END;

    IF ANS = -1 THEN COMERR("Couldn't peek at ELF");
    RETURN(ANS);
    END "peek";

PROCEDURE POKE(INTEGER ADR, CONTENTS);
    BEGIN "poke"  !  Stores CONTENTS at unibus address ADR;
    DEFINE POKE = "'003000000000";
    LABEL POK1, POKMTA, POK3, POK4, POK5;
    INTEGER ANS, ADR1, CNTS;

    ADR1 ← ADR;
    CNTS ← CONTENTS;

    START_CODE;
	MOVE	1,ADR1   	; !  Prepare MTAPE data in POK1;
	LSH	1,-1    	;
	HRRM	1,POK1   	;
	MOVE	1,ELFCHAN	; !  Prepare MTAPE in POKMTA;
	LSH	1,5     	;
	ADDI	1,MTAPE 	;
	HRLM	1,POKMTA   	;
	MOVE	1,CNTS   	;
	MOVEM	1,POK5   	;
    POKMTA:
	POK1             	; !  This will become MTAPE ELFCHAN,POK1;
	JRST POK3        	; !  Error;
	JRST POK4        	; !  OK;
    POK1:
	POKE    		;
    POK5:
	0       		;
    POK3:
	SETOM   POK5     	; ! Error result;
    POK4:
	MOVE    1,POK5   	;
	MOVEM	1,ANS	   	;
    END;

    IF ANS = -1 THEN COMERR("Couldn't poke at ELF");
    RETURN;
    END "poke";

PROCEDURE POKEARRAY(INTEGER ADR, LTH; INTEGER ARRAY CONTENTS);
    BEGIN "pokearray" !  Sends the CONTENTS[1:LTH] to unibus address ADR
    and higher;
    INTEGER ADR1, LTH1, CNTS;
    LABEL SND1, SND4, SNDUST, SNDIOW, SNDOUT;
    DEFINE USETO = "'075000";
    DEFINE OUT = "'057000";
OUTTST(CRLF&"POKING AT "&CVOS(ADR));
    ADR1 ← ADR + MAP_OFFSET;
    CNTS ← LOCATION(CONTENTS[1]);
    LTH1 ← LTH;
    START_CODE;
	MOVE	1,ADR1  	; !  Prepare USETO data in SND1;
	LSH	1,-1    	;
	ADDI	1,'400000  	;
	HRRM	1,SND1  	;
	MOVE	1,ELFCHAN	; !  Prepare USETO in SNDUST;
	LSH	1,5     	;
	ADDI	1,USETO 	;
	HRLM	1,SNDUST   	;
    SNDUST:
	SND1             	; !  This will become USETO ELFCHAN,SND1;
	JRST SND4        	; !  OK;
    SND1:
	'400000000000     	; !  one word transfer, don't grab unibus;
    SNDIOW:
	0		     	; !  Will be IOWD [LTH,CNTS];
    SND4:
	MOVN    1,LTH1   	; !  Prepare IOWD in SNDIOW;
	HRLZM	1,SNDIOW   	;
	MOVE	1,CNTS   	;
	SUBI	1,1		;
	HRRM	1,SNDIOW   	;
	MOVE	1,ELFCHAN	; !  Prepare OUT in SNDOUT;
	LSH	1,5     	;
	ADDI	1,OUT   	;
	HRLM	1,SNDOUT  	;
    SNDOUT:
	SNDIOW	    		; !  This will become OUT ELFCHAN,SNDIOW;
	SETZ	1,        	; !  Success return;
	MOVEM	1,ADR1     	; !  Failure return;
    END;

    IF ADR1 ≠ 0 THEN COMERR("POKEARRAY failed");
    RETURN;
    END "pokearray";

PROCEDURE PEEKARRAY(INTEGER ADR, LTH; INTEGER ARRAY CONTENTS; BOOLEAN EXTSGNBIT(FALSE));
    BEGIN "peekarray" !  Gets the CONTENTS[1:LTH] from unibus address ADR
    and higher;
    ! default mode is for nonextension of sign bit;
    INTEGER ADR1, LTH1, CNTS,EXTND1;
    LABEL GET1, GET4, GETUST, GETIOW, GETIN;
    DEFINE USETI = "'074000";
    DEFINE IN = "'056000";
    DEFINE EXTEND = "'400004000000";
    DEFINE NOEXTEND = "'400000000000";

OUTTST(CRLF&"PEEKING AT "&CVOS(ADR));
    ADR1 ← ADR + MAP_OFFSET;
    CNTS ← LOCATION(CONTENTS[1]);
    LTH1 ← LTH;
    IF EXTSGNBIT THEN EXTND1←EXTEND ELSE EXTND1←NOEXTEND;
    START_CODE;
	MOVE	1,EXTND1	; !  Prepare the correct transfer code ;
	MOVEM	1,GET1		; !  put into the right location ;
	MOVE	1,ADR1  	; !  Prepare USETI data in GET1;
	LSH	1,-1    	;
	ADDI	1,'400000  	;
	HRRM	1,GET1  	;
	MOVE	1,ELFCHAN	; !  Prepare USETI in GETUST;
	LSH	1,5     	;
	ADDI	1,USETI 	;
	HRLM	1,GETUST   	;
    GETUST:
	GET1             	; !  This will become USETI ELFCHAN,GET1;
	JRST	GET4        	; !  OK;
    GET1:
	'400000000000     	; !  ONE WORD TRANSFER, DON'T GRAB UNIBUS;
    GETIOW:
	0		     	; !  Will be IOWD [LTH,CNTS];
    GET4:
	MOVN	1,LTH1   	; !  Prepare IOWD in GETIOW;
	HRLZM	1,GETIOW   	;
	MOVE	1,CNTS   	;
	SUBI	1,1		;
	HRRM	1,GETIOW   	;
	MOVE	1,ELFCHAN	; !  Prepare IN in GETIN;
	LSH	1,5     	;
	ADDI	1,IN	   	;
	HRLM	1,GETIN  	;
    GETIN:
	GETIOW	    		; !  This will become IN ELFCHAN,GETIOW;
	SETZ	1,        	; !  Success return;
	MOVEM	1,ADR1     	; !  Failure return;
    END;

    IF ADR1 ≠ 0 THEN COMERR("PEEKARRAY failed");
    RETURN;
    END "peekarray";

!	eval ;
INTERNAL REAL PROCEDURE RFVAL(INTEGER WORD1,WORD2);
 BEGIN
 ! This procedure gives the real floating point value of a floating point number
  in WORD1 and WORD2 with F format of pdp-11.;
 REAL X;
 INTEGER SIGN,EXPONENT,FRACTION;
! PRINT(CRLF,"WORD1=",CVOS(WORD1),"    WORD2=",CVOS(WORD2));
 SIGN← WORD1 LSH -15;
 EXPONENT← (WORD1 LSH 21) LSH -28 ;
 FRACTION← (((WORD1 LAND '177) LOR (IF EXPONENT THEN '200 ELSE 0)) LSH 16) LOR WORD2 ;
 IF SIGN=1 THEN BEGIN EXPONENT← LNOT EXPONENT; FRACTION← '100000000 - FRACTION; END;
! PRINT(CRLF,"SIGN=",SIGN,"  EXPONENT=",CVOS(EXPONENT),"   FRACTION=",CVOS(FRACTION));
 MEMORY[LOCATION(X),INTEGER]← SIGN LSH 35 LOR EXPONENT LSH 27 LOR FRACTION LSH 3 ;
! PRINT(CRLF,CVOS(X));
 RETURN(X);
 END;

INTEGER PROCEDURE ELFSTATUS;
	BEGIN
	INTEGER I,STATUS;
	CHKESC_I;
	POKE(NOTB11,WAKEUP);
	FOR I←1 STEP 1 UNTIL 10 DO
		BEGIN
DEFINE SLEEP = "'047040000031";  ! The SLEEP UUO;
		START_CODE "gnotyet"
                MOVEI 1,0       ;
                SLEEP           ;  ! Sleep for a tick;
		END "gnotyet";
		STATUS←PEEK(NOTB11);
		IF STATUS≠ASLEEP THEN RETURN(STATUS)
		END;
	RETURN(STATUS);
	END;

INTEGER PROCEDURE LISTENELF;
	BEGIN
	INTEGER STATUS;
	STATUS←ELFSTATUS;
	IF STATUS≠ASLEEP THEN RETURN(STATUS);
	PRINT("ELF is asleep, I will keep trying to wake it till you type esc_I to abort
");
	DO BEGIN
		STATUS←ELFSTATUS;
		CHKESC_I;
	END UNTIL STATUS≠ASLEEP;
	RETURN(STATUS);
	END;

INTERNAL PROCEDURE EVAL(RPTR(EXPR$) EE);
	BEGIN
	INTEGER I,INTSIZE,REALSIZE;
	POKE(NOTB10,LISTEN);
	DO I←LISTENELF UNTIL I=LISTENING;
IFC false thenc	BEGIN
		INTEGER I,J; INTEGER ARRAY BUFF[1:EXPR$:#BODY[EE]];
		FOR I←1 STEP 1 UNTIL EXPR$:#BODY[EE]
			DO IF (J←EXPR$:BODY[EE][I])>GRINCH
				THEN BUFF[I]←PCDBUF+(I-1)*2+(J-GRINCH2)*2
				ELSE BUFF[I]←J;
		POKEARRAY(PCDBUF,EXPR$:#BODY[EE],BUFF);
		END;
endc
	POKEARRAY(PCDBUF,EXPR$:#BODY[EE],EXPR$:BODY[EE]);
	POKE(NOTB10,WORK);
	DO IF (I←LISTENELF)=GAVEUP
		THEN BEGIN POKE(NOTB10,GOSLEEP);
			ERROR("abandoned this instruction midway");
		     END  UNTIL I=DONEWORKING;
	PEEKARRAY(NOTB11-MAP_OFFSET,8,NOTBOX);
	IF $INTSIZ←INTSIZ THEN PEEKARRAY(INTBUF,INTSIZ,$INBUF,TRUE);
	IF $FPSIZ←FPSIZ THEN
		BEGIN
		PEEKARRAY(FPBUF,2*FPSIZ,TMPBUF);
		FOR I←1 STEP 1 UNTIL FPSIZ DO
			$FPBUF[I]←RFVAL(TMPBUF[I*2-1],TMPBUF[I*2]);
		END;
	POKE(NOTB10,GOSLEEP);
	$FPPTR←$INTPTR←0;
	END;
ifc false thenc
RPTR(EVAL_REC)PROCEDURE EVALREC(RPTR($EXPR)EE);
	BEGIN
	RPTR(EVAL_REC)PTR;
	EVAL(EE);
	PTR←NEW_RECORD(EVAL_REC);
	IF EVAL_REC:#INT[PTR]←$INTSIZ THEN
		BEGIN
		INTEGER ARRAY INT[1:$INTSIZ];
		ARRBLT(INT[1],$INTBUF[1],$INTSIZ);
		MEMORY[LOCATION(EVAL_REC:INT[PTR])]↔MEMORY[LOCATION(INT)];
		END;
	IF EVAL_REC:#FP[PTR]←$FPSIZ THEN
		BEGIN
		REAL ARRAY FP[1:$FPSIZ];
		ARRBLT(FP[1],$FPBUF[1],$FPSIZ);
		MEMORY[LOCATION(EVAL_REC:FP[PTR])]↔MEMORY[LOCATION(FP)];
		END;
	RETURN(PTR);
	END;
endc

!	alinit;
INTERNAL PROCEDURE ALINIT;
    BEGIN "init" 
    INTEGER COUNT, BRCHAR, EOF, FLAG;
    OWN BOOLEAN ONCE; comment INITIALIZE(ONCE←FALSE);
    INTEGER I;
    !  Only allow one initialization of ELF channel;
    IF NOT ONCE 
    THEN BEGIN
	    !  Initialize the ELF for output;
	    ELFCHAN ← GETCHAN;
	    OPEN(ELFCHAN,"ELF",'17,0,0,COUNT,BRCHAR,EOF);
	    ONCE←TRUE
        END;
    DO I←LISTENELF UNTIL I=AWAKE;
    PEEKARRAY(NOTB11-MAP_OFFSET,8,NOTBOX);
    END "init";

END;